SUBROUTINE WRTD2CDF
USE PARKIND1  ,ONLY : JPIM     ,JPRB,   JPRD, JPRM
USE YOMHOOK   ,ONLY : LHOOK    ,DR_HOOK, JPHOOK
! (C) Copyright 2013- ECMWF.
!
! This software is licensed under the terms of the Apache Licence Version 2.0
! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
! In applying this licence, ECMWF does not waive the privileges and immunities
! granted to it by virtue of its status as an intergovernmental organisation
! nor does it submit to any jurisdiction.

!**** *WRTDCDF*  - writes diagnostics to NetCDF files, 2 meter diagnostic

!     Purpose.
!     --------
!        writes out diagnostic variables

!**   Interface.
!     ----------
!        *CALL* *WRTD2CDF

!     Explicit arguments :
!     --------------------

!        Implicit arguments :
!        --------------------

!     Method.
!     -------
!        See documentation

!     Externals.
!     ----------
!        None

!     Reference.
!     ----------

!     Author.
!     -------
!        E. Dutra

!     Modifications.
!     --------------
!        original: 16/12/2013

!
! USE YOMCT01S , ONLY : NSTART   ,NFRPOS
! USE YOETHF   , ONLY : R2ES, R3LES, R3IES, R4LES, R4IES, R5LES, R5ALVCP, &
!            &          R5IES, R5ALSCP, RALVDCP, RTICE, RTWAT, RTWAT_RTICE_R, &
!            &          RTICECU, RTWAT_RTICECU_R, RALSDCP,RHOH2O
! 
! USE YOMGPD1S , ONLY : VFCVL    ,VFCVH    ,VFTVL    ,VFTVH    ,VFSOTY   ,&
!            &VFOCDEPTH,VFZO     !KPP

! USE YOMRIP   , ONLY : RSTATI
! USE YOEPHY   , ONLY : LEVGEN, LECTESSEL 
! USE YOESOIL1S, ONLY : RDAW     ,RWPWP    ,RWSAT    ,RWPWPM,RWSATM,RWCAPM
! USE YOMDPHY  , ONLY : NLAT     ,NLON     ,NPOI ,NTILES ,NVHILO, &
!                     & NLALO    ,NSLAB    ,ISLAB   ,NCSS , NSOTY, NCOM !KPP
! USE YOMGP1SA , ONLY : FSNNUA   ,TSLNUA   ,QLINUA   ,QLQNUA,&
!             &TSNNUA   ,WRENUA   ,ASNNUA   ,RSNNUA
USE YOMGDI1S , ONLY : D1T2M2    ,D1D2M2            
USE YOMGC1S  , ONLY : LMASK
USE YOMDYN1S , ONLY : NSTEP    ,TSTEP
USE YOMLUN1S , ONLY : NPOSD2M  , RMISS, NULOUT
USE YOMLOG1S , ONLY : LACCUMW  ,LRESET   ,NACCUR   ,NDIMCDF &
           &,LWRD2M,LNCSNC
USE YOMCST   , ONLY : RTT      ,RDAY,  RMV   ,  RMD, RLVTT, RLSTT
USE YOMCT01S , ONLY : NSTART   ,NFRPOS
USE YOETHF   , ONLY : R2ES, R3LES, R3IES, R4LES, R4IES, R5LES, R5ALVCP, &
           &          R5IES, R5ALSCP, RALVDCP, RTICE, RTWAT, RTWAT_RTICE_R, &
           &          RTICECU, RTWAT_RTICECU_R, RALSDCP,RHOH2O
USE YOMDPHY  , ONLY : NLAT     ,NLON     ,NPOI , NPOIP, NPOIOFF, NLALO,&
           &          NCSS
USE YOMRIP   , ONLY : RSTATI
USE MPL_MODULE
IMPLICIT NONE

! !* Netcdf Interface
INTEGER NVARID,NPOS,NSTPP,IERR
INTEGER ISTART1(1),ISTART3(3),ISTART4(4)
INTEGER ICOUNT1(1),ICOUNT3(3),ICOUNT4(4),ICOUNT4O(4)
REAL(KIND=JPRM),ALLOCATABLE :: ZOUTPUTS(:)
REAL(KIND=JPRD),ALLOCATABLE :: ZOUTPUT(:)
REAL(KIND=JPRD)             :: ZTIME
! 
!* Local variables
INTEGER(KIND=JPIM), PARAMETER :: JPNCDF=1  !KPP 7+6CTESSEL
REAL(KIND=JPRB),ALLOCATABLE :: ZVALUE(:)
INTEGER(KIND=JPIM) IPOS(JPNCDF)
LOGICAL LPOS(JPNCDF)
INTEGER(KIND=JPIM) :: IX1,IX2,IY1,IY2,NLEN,IST,IEN,ISLOT,J,JL,ISTP,IENP
! REAL(KIND=JPRB) :: ZWA,ZMM,ZMM2,ZPA,ZJUL,ZWPWP,ZWSAT,ZCVL,ZCVH,ZBOT,ZF,&
!      &  ZTOP,ZRVCOV(0:20),ZRVROOTSA(4,0:20),FOEEWMO
REAL(KIND=JPRB),ALLOCATABLE :: ZBUF(:)
INTEGER(KIND=JPIM) :: MYPROC, NPROC
REAL(KIND=JPHOOK)    :: ZHOOK_HANDLE

#include "surf_inq.h"
#include "netcdf.inc"
#include "fcttre.h"

IF (LHOOK) CALL DR_HOOK('WRTD2CDF',0,ZHOOK_HANDLE)

MYPROC = MPL_MYRANK()
NPROC  = MPL_NPROC()

ISTP   = NPOIOFF(1)+1
IENP   = NPOIOFF(NPROC+1)

WRITE(NULOUT,*) 'WRTD2CDF'

IF(NDIMCDF == 2)THEN
  IX1=1
  IX2=NLON
  IY1=1
  IY2=NLAT
  NLEN=(IX2-IX1+1)*(IY2-IY1+1)
  IST=IX1+(IY1-1)*NLON
  IEN=IST+NLEN-1
ELSE
  IST=1
  IEN=NLALO
  NLEN=IEN-IST+1
ENDIF


!* ===============================================================
!     START OUTPUT
!* ===============================================================

IPOS(1)=NPOSD2M

LPOS(1)=LWRD2M

ISTART1(1)=(NSTEP-NSTART)/NFRPOS
ISLOT=ISTART1(1)
NSTPP=NSTEP
ZTIME=REAL(RSTATI,KIND=JPRD)-REAL(0.5_JPRB*TSTEP,KIND=JPRD)
IF (ISLOT < 1) RETURN
IF( MYPROC == 1 ) THEN
  DO J=1,JPNCDF
    IF(LPOS(J))THEN
      NPOS=IPOS(J)
      NVARID = NCVID(NPOS,'time',IERR)
      CALL NCVPT1 (NPOS,NVARID,ISTART1,ZTIME,IERR)
      NVARID = NCVID(NPOS,'timestp',IERR)
      CALL NCVPT1 (NPOS,NVARID,ISTART1,NSTPP,IERR)
    ENDIF
  ENDDO
ENDIF
IF(NDIMCDF == 2)THEN
  ISTART3(1)=IX1
  ISTART3(2)=IY1
  ISTART3(3)=ISLOT
  ICOUNT3(1)=IX2-IX1+1
  ICOUNT3(2)=IY2-IY1+1
  ICOUNT3(3)=1

  ISTART4(1)=IX1
  ISTART4(2)=IY1
  ISTART4(3)=1
  ISTART4(4)=ISLOT
  ICOUNT4(1)=IX2-IX1+1
  ICOUNT4(2)=IY2-IY1+1
  ICOUNT4(3)=NCSS
  ICOUNT4(4)=1
ELSE
  ISTART3(1)=IST
  ISTART3(2)=ISLOT
  ICOUNT3(1)=NLEN
  ICOUNT3(2)=1

  ISTART4(1)=IST
  ISTART4(2)=1
  ISTART4(3)=ISLOT
  ICOUNT4(1)=NLEN
  ICOUNT4(2)=NCSS
  ICOUNT4(3)=1
ENDIF

ALLOCATE (ZVALUE(NPOI))
ALLOCATE (ZOUTPUT(NLEN))        !INFLATED OUTPUT ARRAY
ALLOCATE (ZOUTPUTS(NLEN))       !INFLATED OUTPUT ARRAY
ALLOCATE (ZBUF(NLEN))
      
IF(LWRD2M)THEN
!* -- Surface state variables
!******************************************************************
  NPOS = NPOSD2M

!     2m temperature (instantaneous only)
  IF( MYPROC == 1 ) NVARID = NCVID(NPOS,'T2m',IERR)
  ZVALUE(1:NPOI)=D1T2M2(1:NPOI,1)
  CALL MPL_GATHERV(PRECVBUF=ZBUF(:),KROOT=1,PSENDBUF=ZVALUE(:),KRECVCOUNTS=NPOIP(:),CDSTRING="WRTD2CDF:")
  IF( MYPROC == 1 ) THEN
    ZOUTPUT= UNPACK(ZBUF(:),LMASK(ISTP:IENP),RMISS)
    IF(NACCUR == 1)THEN
      ZOUTPUTS(:)=ZOUTPUT(:)
      CALL NCVPT (NPOS,NVARID,ISTART3,ICOUNT3,ZOUTPUTS,IERR)
    ELSE
      CALL NCVPT (NPOS,NVARID,ISTART3,ICOUNT3,ZOUTPUT,IERR)
    ENDIF 
  ENDIF

!     2m relative humidity (instantaneous only)
  IF( MYPROC == 1 ) NVARID = NCVID(NPOS,'RH2m',IERR)
  DO JL=1,NPOI
    ZVALUE(JL)=100.0_JPRB*FOEEWMO(D1D2M2(JL,1))/FOEEWMO(D1T2M2(JL,1))
  ENDDO
  CALL MPL_GATHERV(PRECVBUF=ZBUF(:),KROOT=1,PSENDBUF=ZVALUE(:),KRECVCOUNTS=NPOIP(:),CDSTRING="WRTDCDF:")
  IF( MYPROC == 1 ) THEN
    ZOUTPUT= UNPACK(ZBUF(:),LMASK(ISTP:IENP),RMISS)
    IF(NACCUR == 1)THEN
      ZOUTPUTS(:)=ZOUTPUT(:)
      CALL NCVPT (NPOS,NVARID,ISTART3,ICOUNT3,ZOUTPUTS,IERR)
    ELSE
      CALL NCVPT (NPOS,NVARID,ISTART3,ICOUNT3,ZOUTPUT,IERR)
    ENDIF
  ENDIF
  
  !     2m dewpoint temperature (instantaneous only)
  IF( MYPROC == 1 ) NVARID = NCVID(NPOS,'D2m',IERR)
  ZVALUE(1:NPOI)=D1D2M2(1:NPOI,1)
  CALL MPL_GATHERV(PRECVBUF=ZBUF(:),KROOT=1,PSENDBUF=ZVALUE(:),KRECVCOUNTS=NPOIP(:),CDSTRING="WRTDCDF:")
  IF( MYPROC == 1 ) THEN
    ZOUTPUT= UNPACK(ZBUF(:),LMASK(ISTP:IENP),RMISS)
    IF(NACCUR == 1)THEN
      ZOUTPUTS(:)=ZOUTPUT(:)
      CALL NCVPT (NPOS,NVARID,ISTART3,ICOUNT3,ZOUTPUTS,IERR)
    ELSE
      CALL NCVPT (NPOS,NVARID,ISTART3,ICOUNT3,ZOUTPUT,IERR)
    ENDIF
  ENDIF

  IF( MYPROC == 1 ) THEN
    IF (LNCSNC) CALL NCSNC(NPOS,IERR)
  ENDIF
ENDIF



DEALLOCATE (ZOUTPUT)    !INFLATED OUTPUT ARRAY
DEALLOCATE (ZOUTPUTS)   !INFLATED OUTPUT ARRAY
DEALLOCATE (ZVALUE)
DEALLOCATE (ZBUF)

IF (LHOOK) CALL DR_HOOK('WRTD2CDF',1,ZHOOK_HANDLE)

RETURN
END SUBROUTINE WRTD2CDF
